home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Whiteline: delta
/
whiteline CD Series - delta.iso
/
progtool
/
modula2
/
module
/
liste.mod
< prev
next >
Wrap
Text File
|
1995-11-25
|
4KB
|
174 lines
IMPLEMENTATION MODULE Liste;
FROM SYSTEM IMPORT TSIZE;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
TYPE List = POINTER TO ListHeader;
ListElementPointer = POINTER TO ListElement;
ListHeader = RECORD
current,
first,last : ListElementPointer;
END ;
ListElement = RECORD
next,prev : ListElementPointer;
value :ARRAY[0..9] OF INTEGER;
END ;
PROCEDURE MakeList(VAR L:List);
BEGIN
ALLOCATE(L,TSIZE(ListHeader));
L^.first:=NIL;
L^.last:=NIL;
L^.current:=NIL;
END MakeList;
PROCEDURE KillList(VAR L:List);
VAR p,q:ListElementPointer;
BEGIN
p:=L^.first;
WHILE (p#NIL) DO
q:=p;
p:=p^.next;
DEALLOCATE(q);
END(*WHILE*);
DEALLOCATE(L);
L:=NIL
END KillList;
PROCEDURE First(VAR L:List);
BEGIN
L^.current:=L^.first;
END First;
PROCEDURE Last(VAR L:List);
BEGIN
L^.current:=L^.last;
END Last;
PROCEDURE Next(VAR L:List);
BEGIN
IF (~Empty(L) AND (L^.current^.next # NIL))THEN
L^.current:=L^.current^.next;
END(*IF*);
END Next;
PROCEDURE Prev(VAR L:List);
BEGIN
IF (~Empty(L) AND (L^.current^.prev # NIL))THEN
L^.current:=L^.current^.prev;
END(*IF*);
END Prev;
PROCEDURE Empty(VAR L:List):BOOLEAN;
BEGIN
RETURN L^.first=NIL
END Empty;
PROCEDURE AtFirst(VAR L:List):BOOLEAN;
BEGIN
RETURN L^.current=L^.first
END AtFirst;
PROCEDURE AtLast(VAR L:List):BOOLEAN;
BEGIN
RETURN L^.current=L^.last
END AtLast;
PROCEDURE GetValue(VAR L:List;VAR Value :ARRAY OF INTEGER):BOOLEAN;
VAR i:INTEGER;
BEGIN
IF ~Empty(L) THEN
FOR i:=0 TO HIGH(L^.current^.value) DO
Value[i]:=L^.current^.value[i];
END(*FOR*);
RETURN TRUE
ELSE
RETURN FALSE
END(*IF*);
END GetValue;
PROCEDURE SetValue(VAR L:List;Value :ARRAY OF INTEGER);
VAR i:INTEGER;
BEGIN
IF ~Empty(L) THEN
FOR i:=0 TO HIGH(L^.current^.value) DO
L^.current^.value[i]:=Value[i];
END(*FOR*);
END(*IF*);
END SetValue;
PROCEDURE EnterElement(VAR L:List);
VAR p,q :ListElementPointer;
BEGIN
ALLOCATE(p,TSIZE(ListElement));
IF Empty(L) THEN
L^.first:=p;
L^.last:=p;
p^.next:=NIL;
p^.prev:=NIL;
ELSIF AtFirst(L) THEN
p^.next:=L^.first;
L^.first:=p;
p^.prev:=NIL;
L^.current^.prev:=p;
ELSE
p^.next:=L^.current;
p^.prev:=L^.current^.prev;
q:=L^.current^.prev;
q^.next:=p;
L^.current^.prev:=p;
END(*IF*);
L^.current:=p;
END EnterElement;
PROCEDURE AppendElement(VAR L:List);
VAR p,q :ListElementPointer;
BEGIN
ALLOCATE(p,TSIZE(ListElement));
IF Empty(L) THEN
L^.first:=p;
L^.last:=p;
p^.next:=NIL;
p^.prev:=NIL;
ELSIF AtLast(L) THEN
p^.prev:=L^.last;
L^.last:=p;
p^.next:=NIL;
L^.current^.next:=p;
ELSE
p^.next:=L^.current^.next;
p^.prev:=L^.current;
q:=L^.current^.next;
q^.prev:=p;
L^.current^.next:=p;
END(*IF*);
L^.current:=p;
END AppendElement;
PROCEDURE RemoveElement(VAR L:List);
VAR p,q :ListElementPointer;
BEGIN
IF ~Empty(L) THEN
p:=L^.current;
IF (AtFirst(L) AND AtLast(L)) THEN
L^.first:=NIL;
L^.last:=NIL;
L^.current:=NIL;
ELSIF AtFirst(L) THEN
L^.first:=L^.current^.next;
L^.first^.prev:=NIL;
L^.current:=L^.current^.next;
ELSIF AtLast(L) THEN
L^.last:=L^.current^.prev;
L^.last^.next:=NIL;
L^.current:=L^.current^.prev;
ELSE
p^.prev^.next:=p^.next;
p^.next^.prev:=p^.prev;
L^.current:=L^.current^.next;
END(*IF*);
DEALLOCATE(p);
END(*IF*);
END RemoveElement;
END Liste.